home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / arvis1 / earthblo.ctl < prev    next >
Text File  |  1999-08-13  |  4KB  |  105 lines
  1. VERSION 5.00
  2. Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "PICCLP32.OCX"
  3. Begin VB.UserControl EarthBlow1 
  4.    Alignable       =   -1  'True
  5.    Appearance      =   0  'Flat
  6.    AutoRedraw      =   -1  'True
  7.    BackColor       =   &H00000000&
  8.    ClientHeight    =   3735
  9.    ClientLeft      =   0
  10.    ClientTop       =   0
  11.    ClientWidth     =   5310
  12.    ControlContainer=   -1  'True
  13.    DefaultCancel   =   -1  'True
  14.    ForwardFocus    =   -1  'True
  15.    ScaleHeight     =   3735
  16.    ScaleWidth      =   5310
  17.    Begin VB.PictureBox Picture1 
  18.       Appearance      =   0  'Flat
  19.       AutoRedraw      =   -1  'True
  20.       AutoSize        =   -1  'True
  21.       BackColor       =   &H00000000&
  22.       BorderStyle     =   0  'None
  23.       ForeColor       =   &H80000008&
  24.       Height          =   1815
  25.       Left            =   0
  26.       ScaleHeight     =   1815
  27.       ScaleWidth      =   2220
  28.       TabIndex        =   0
  29.       Top             =   0
  30.       Width           =   2220
  31.    End
  32.    Begin PicClip.PictureClip PClip 
  33.       Left            =   810
  34.       Top             =   1080
  35.       _ExtentX        =   18891
  36.       _ExtentY        =   7303
  37.       _Version        =   393216
  38.       Rows            =   3
  39.       Cols            =   7
  40.    End
  41. End
  42. Attribute VB_Name = "EarthBlow1"
  43. Attribute VB_GlobalNameSpace = False
  44. Attribute VB_Creatable = True
  45. Attribute VB_PredeclaredId = False
  46. Attribute VB_Exposed = False
  47. '»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»'
  48. ' This Control is Used to Show the Earth       '
  49. ' Dissolving If it Is Not Saved By The Player  '
  50. '______________________________________________'
  51. Dim ExitLoop As Boolean, T, TT
  52. 'Sets The Control To a Round Shape
  53. Sub SetShape(Optional Round As Boolean = True, Optional Square As Boolean = False)
  54. If Round = True Then
  55.  SetWindowRgn UserControl.hWnd, CreateEllipticRgn(16, 6, (UserControl.Width / Screen.TwipsPerPixelX) - 13, (UserControl.Height / Screen.TwipsPerPixelY) - 8), True
  56. ElseIf Square = True Then
  57.  SetWindowRgn UserControl.hWnd, CreateRectRgn(0, 0, (UserControl.Width / Screen.TwipsPerPixelX), (UserControl.Height / Screen.TwipsPerPixelY)), True
  58. End If
  59. End Sub
  60. Sub UserControl_Initialize()
  61.  ' load the animation picture
  62.  ThisDir
  63.  PClip.Picture = LoadPicture("EarthBlow.img")
  64.  If PClip.Picture = 0 Then LoadPicture (App.Path & "\" & "EarthBlow.img")
  65.  Picture1.AutoSize = False
  66.  Picture1.Picture = PClip.GraphicCell(0)
  67.  Picture1.AutoSize = True
  68. End Sub
  69.  
  70. '»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»'
  71. ' Calling "Animate" By Itself Will Display The Automated         '
  72. ' Animation, But The Others Enable Slowing Down of the dissolve, '
  73. ' Times To Loop The Animation and To Show Only Certain Frames    '
  74. '________________________________________________________________'
  75. Public Sub Animate(Optional Delay = 0, Optional TimesToLoop As Integer = 1, Optional Frame As Integer = 21)
  76. Pause Delay ' if the user wants to wait a few secs before the animation starts
  77. If Frame < 21 Then
  78.  Picture1.Picture = PClip.GraphicCell(Frame)
  79.  Picture1.Refresh
  80.  Pause 0.1
  81.  Exit Sub
  82. End If
  83. Dim i, II
  84. For II = 1 To TimesToLoop
  85.  For i = 0 To 20 ' go through each frame and display it
  86.   Picture1.Picture = PClip.GraphicCell(i)
  87.   Pause 0.1
  88.   If ExitLoop = True Then Exit Sub
  89.  Next i
  90. Next II
  91. End Sub
  92. Private Sub UserControl_Resize()
  93.  UserControl.Width = Picture1.Width
  94.  UserControl.Height = Picture1.Height
  95. End Sub
  96. Sub Pause(T)
  97.  TT = Timer
  98.  Do
  99.   Picture1.Refresh
  100.  Loop Until Timer > T + TT
  101. End Sub
  102. Private Sub UserControl_Terminate()
  103.  ExitLoop = True
  104. End Sub
  105.